home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / CMPLTPAS / GETSTRIN.PAS < prev    next >
Pascal/Delphi Source File  |  1988-07-14  |  5KB  |  124 lines
  1. {->>>>GetString<<<<--------------------------------------------}
  2. {                                                              }
  3. { Filename : GETSTRIN.SRC -- Last Modified 7/14/88             }
  4. {                                                              }
  5. { This is a generalized string-input procedure.  It shows a    }
  6. { field between vertical bar characters at X,Y, with any       }
  7. { string value passed initially in XString left-justified in   }
  8. { the field.  The current state of XString when the user       }
  9. { presses Return is returned in XString.  The user can press   }
  10. { ESC and leave the passed value of XString undisturbed, even  }
  11. { if XString was altered prior to his pressing ESC.            }
  12. {                                                              }
  13. {     From: COMPLETE TURBO PASCAL 5.0  by Jeff Duntemann       }
  14. {    Scott, Foresman & Co., Inc. 1988   ISBN 0-673-38355-5     }
  15. {--------------------------------------------------------------}
  16.  
  17. PROCEDURE GetString(    X,Y      : Integer;
  18.                     VAR XString  : String80;
  19.                         MaxLen   : Integer;
  20.                         Capslock : Boolean;
  21.                         Numeric  : Boolean;
  22.                         GetReal  : Boolean;
  23.                     VAR RValue   : Real;
  24.                     VAR IValue   : Integer;
  25.                     VAR Error    : Integer;
  26.                     VAR Escape   : Boolean);
  27.  
  28.  
  29. VAR I,J        : Integer;
  30.     Ch         : Char;
  31.     Cursor     : Char;
  32.     Dot        : Char;
  33.     BLength    : Byte;
  34.     ClearIt    : String80;
  35.     Worker     : String80;
  36.     Printables : SET OF Char;
  37.     Lowercase  : SET OF Char;
  38.     Numerics   : SET OF Char;
  39.     CR         : Boolean;
  40.  
  41.  
  42. BEGIN
  43.   Printables := [' '..'}'];               { Init sets }
  44.   Lowercase  := ['a'..'z'];
  45.   IF GetReal THEN Numerics := ['-','.','0'..'9','E','e']
  46.     ELSE Numerics := ['-','0'..'9'];
  47.   Cursor := '_'; Dot := '.';
  48.   CR := False; Escape := False;
  49.   FillChar(ClearIt,SizeOf(ClearIt),'.');  { Fill the clear string  }
  50.   ClearIt[0] := Chr(MaxLen);              { Set clear string to MaxLen }
  51.  
  52.                                 { Convert numbers to string if required:  }
  53.   IF Numeric THEN               { Convert zero values to null string: }
  54.     IF (GetReal AND (RValue = 0.0)) OR
  55.        (NOT GetReal AND (IValue = 0)) THEN XString := ''
  56.     ELSE                        { Convert nonzero values to string equiv: }
  57.       IF GetReal THEN Str(RValue:MaxLen,XString)
  58.         ELSE Str(IValue:MaxLen,XString);
  59.  
  60.                                           { Truncate string value to MaxLen }
  61.   IF Length(XString) > MaxLen THEN XString[0] := Chr(MaxLen);
  62.   GotoXY(X,Y); Write('|',ClearIt,'|');    { Draw the field  }
  63.   GotoXY(X+1,Y); Write(XString);
  64.   IF Length(XString)<MaxLen THEN
  65.     BEGIN
  66.       GotoXY(X + Length(XString) + 1,Y);
  67.       Write(Cursor)                       { Draw the Cursor }
  68.     END;
  69.   Worker := XString;      { Fill work string with input string     }
  70.  
  71.   REPEAT                  { Until ESC or (CR) entered }
  72.                           { Wait here for keypress:   }
  73.     WHILE NOT KeyPressed DO BEGIN {NULL} END;
  74.     Ch := ReadKey;
  75.  
  76.     IF Ch IN Printables THEN              { If Ch is printable... }
  77.       IF Length(Worker) >= MaxLen THEN UhUh ELSE
  78.         IF Numeric AND (NOT (Ch IN Numerics)) THEN UhUh ELSE
  79.           BEGIN
  80.             IF Ch IN Lowercase THEN IF Capslock THEN Ch := Chr(Ord(Ch)-32);
  81.             Worker := CONCAT(Worker,Ch);
  82.             GotoXY(X+1,Y); Write(Worker);
  83.             IF Length(Worker) < MaxLen THEN Write(Cursor)
  84.           END
  85.     ELSE   { If Ch is NOT printable... }
  86.       CASE Ord(Ch) OF
  87.        8,127 : IF Length(Worker) <= 0 THEN UhUh ELSE
  88.                   BEGIN
  89.                     Delete(Worker,Length(Worker),1);
  90.                     GotoXY(X+1,Y); Write(Worker,Cursor);
  91.                     IF Length(Worker) < MaxLen-1 THEN Write(Dot);
  92.                   END;
  93.  
  94.        13 : CR := True;          { Carriage return }
  95.  
  96.        24 : BEGIN                { CTRL-X : Blank the field }
  97.               GotoXY(X+1,Y); Write(ClearIt);
  98.               Worker := '';      { Blank out work string }
  99.             END;
  100.  
  101.        27 : Escape := True;      { ESC }
  102.        ELSE UhUh                 { CASE ELSE }
  103.     END; { CASE }
  104.  
  105.   UNTIL CR OR Escape;            { Get keypresses until (CR) or }
  106.                                  { ESC pressed }
  107.   GotoXY(X + 1,Y); Write(ClearIt);
  108.   GotoXY(X + 1,Y); Write(Worker);
  109.   IF CR THEN                     { Don't update XString if ESC hit }
  110.     BEGIN
  111.       XString := Worker;
  112.       IF Numeric THEN            { Convert string to Numeric values }
  113.         CASE GetReal OF
  114.           True  : Val(Worker,RValue,Error);
  115.           False : Val(Worker,IValue,Error)
  116.         END { CASE }
  117.       ELSE
  118.         BEGIN
  119.           RValue := 0.0;
  120.           IValue := 0
  121.         END
  122.     END
  123.  
  124. END;  { GETString }